home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MOS / USERBREA.I < prev    next >
Encoding:
Modula Implementation  |  1990-12-17  |  6.9 KB  |  217 lines
  1. IMPLEMENTATION MODULE UserBreak;
  2. (*$M-,S-,Y+,R-*)
  3.  
  4. (*
  5.  * Zweck des Moduls: Siehe Definitionstext.
  6.  *
  7.  * Das Modul hängt sich auf zwei Arten ins Laufzeitsystem ein:
  8.  * 1. Für die Control-C-Erkennung werden Watchdogs (s. EventHandler)
  9.  *    installiert. Eine globale BOOLEAN-Var 'break' wird von ihnen
  10.  *    geprüft (sie wird u.a. vom Keyboard-Watchdog gesetzt). Ist sie
  11.  *    TRUE, wird 'doBreak' aufgerufen. Dort wird eine GEM-Dialogbox
  12.  *    angezeigt und ggf. das Programm beendet.
  13.  * 2. Für Control-Enter wird direkt der Tastatur-Interrupt angezapft.
  14.  *    Wird darin Control-Enter erkannt, wird sofort das Programm beendet.
  15.  *    Dort wird zudem auch Control-C erkannt, jedoch dann nur 'Break' auf
  16.  *    TRUE gesetzt.
  17.  *
  18.  * 02.04.88 TT: Programmabbruch nur im Hauptprozeß (nicht in Envelopes) möglich.
  19.  * 09.06.88 TT: Es wird immer die zuletzt statt die zuerst eingegebene Taste
  20.  *              überprüft.
  21.  * 04.11.90 TT: Hängt nicht mehr im VBL sondern direkt in Kbd-Vektor;
  22.  *              Benutzt nicht mehr Coroutinen (wg. Super-Aufruf/TRAP-Benutzung)
  23.  * 09.12.90 TT: 'Break' wird exportiert
  24.  * 11.12.90 TT: Nach Ctrl-C wird trotzdem noch auf Ctrl-Enter reagiert.
  25.  * 17.12.90 TT: Ctrl-C wird nicht aus Kbd-Puffer entfernt, damit ggf. GEMDOS
  26.  *              auch noch reagieren kann.
  27.  *)
  28.  
  29. FROM SYSTEM IMPORT ASSEMBLER, ADDRESS, CALLSYS, ADR, CAST, WORD, BYTE;
  30. FROM XBIOS IMPORT KeyboardVectors;
  31. FROM KbdCtrl IMPORT LookMostRecentKey, GetKey, ClrKeyBuffer;
  32. FROM SysTypes IMPORT ScanDesc;
  33. FROM SysCtrl IMPORT GetScanAddr, ScanBack;
  34. FROM GEMScan IMPORT InputScan, InitChain, CallingChain;
  35. FROM Calls IMPORT NewCaller, Registers, CallExtRegs, CallProc;
  36. FROM MOSGlobals IMPORT Key, MemArea, UserBreak, MEM;
  37. FROM PrgCtrl IMPORT CatchProcessTerm, ProcessState, PState, TermCarrier,
  38.         TermProcess;
  39. FROM GrafBase IMPORT Point;
  40. FROM AESForms IMPORT FormAlert;
  41. FROM GEMGlobals IMPORT GemChar, MButtonSet, SpecialKeySet;
  42. FROM AESEvents IMPORT Event, MessageBuffer, unspecMessage;
  43. FROM EventHandler IMPORT EventProc, WatchDogCarrier, MessageProc,
  44.         DeInstallWatchDog, InstallWatchDog;
  45. IMPORT SysBuffers, XBRA;
  46.  
  47.  
  48. CONST  SoftBreak     = 3C;          (* Code für Ctrl-C *)
  49.        HardBreakScan = $72;
  50.        HardBreakChar = CHAR ($0A);  (* Code für Ctrl-Enter *)
  51.  
  52.        Kennung = 'MM2U';  (* XBRA-Kennung *)
  53.  
  54.  
  55. VAR terminating, enabled: BOOLEAN;
  56.     entry: ADDRESS;
  57.  
  58. (*
  59.  * Folgende Routine hängt im Interrupt-Vektor für Tastendrücke
  60.  *)
  61. PROCEDURE hdlKbd (VAR r: Registers);
  62.   TYPE ByteSet = SET OF [0..7];
  63.   VAR k: Key; ok: BOOLEAN; ISRB [$FFFFFA11]: ByteSet;
  64.   BEGIN
  65.     CallExtRegs (XBRA.PreviousEntry (entry), r);
  66.     IF NOT terminating THEN
  67.       LookMostRecentKey (k, ok); (* gerade eben gedrückte Taste holen *)
  68.       WITH k DO
  69.         IF ch = SoftBreak THEN (* Control-C? *)
  70.           Break:= TRUE;
  71.         ELSIF (ch = HardBreakChar) & (scan = HardBreakScan) THEN
  72.           terminating:= TRUE;
  73.           ClrKeyBuffer;
  74.           IF ProcessState () = running THEN
  75.             (* sofortiger Programmabbruch bei Control-Enter *)
  76.             EXCL (ISRB, 6);
  77.             TermProcess (UserBreak)
  78.           END
  79.         END
  80.       END
  81.     END;
  82.   END hdlKbd;
  83.  
  84. (*
  85.  * Scan-Box anzeigen, ggf. Programm beeenden
  86.  *)
  87. PROCEDURE doBreak (dummy:ADDRESS);
  88.   VAR button, index: CARDINAL; scan: ScanDesc; b: BOOLEAN;
  89.   BEGIN
  90.     ClrKeyBuffer;
  91.     GetScanAddr (scan);
  92.     FOR index:= 1 TO 5 DO b:= ScanBack (scan) END;
  93.     InitChain (scan);
  94.     index:= 1;
  95.     InputScan ('Unterbrechung vom Anwender', index);
  96.     FormAlert (1, '[2][Programm beenden ?][ Ja |Nein]', button);
  97.     Break:= FALSE;
  98.     IF button = 1 THEN
  99.       TermProcess (UserBreak)
  100.     END;
  101.   END doBreak;
  102.  
  103. (*
  104.  * Es folgen die Watchdog-Prozeduren
  105.  *)
  106.  
  107. PROCEDURE handleBreak;
  108.   BEGIN
  109.     IF Break & (ProcessState () = running) THEN
  110.       (* 'doBreak' bekommt einen eigenen Stack, da nie sicher ist, daß
  111.        * der augenblickliche Stack noch ausreicht. Dabei wird der Stack
  112.        * verwendet, der für die Laufzeitfehlerbehandlung reserviert ist.
  113.        * Da hier keine Laufzeitfehler auftreten dürften und diese Routine
  114.        * auch nicht während einer Laufzeitfehlerbehandlung aktiv werden
  115.        * kann, dürfte es dabei keine Kollisionen (gleichzeite Benutzung
  116.        * des Stack-Speichers durch mehrere Routinen) geben.               *)
  117.       CallProc (doBreak, NIL, MEM (SysBuffers.HdlErrorStack))
  118.     END
  119.   END handleBreak;
  120.  
  121. PROCEDURE handleTimer (): BOOLEAN;
  122.   BEGIN
  123.     handleBreak;
  124.     RETURN TRUE
  125.   END handleTimer;
  126.  
  127. PROCEDURE handleKey ( VAR c: GemChar; VAR s: SpecialKeySet ): BOOLEAN;
  128.   BEGIN
  129.     IF (c.ascii = SoftBreak)
  130.     OR (c.ascii = HardBreakChar) & (c.scan = CAST (BYTE,HardBreakScan)) THEN
  131.       Break:= TRUE
  132.     END;
  133.     handleBreak;
  134.     RETURN TRUE
  135.   END handleKey;
  136.  
  137. PROCEDURE handleBut ( clicks: CARDINAL; loc: Point;
  138.                       buts: MButtonSet; keys: SpecialKeySet ) :BOOLEAN;
  139.   BEGIN
  140.     handleBreak;
  141.     RETURN TRUE
  142.   END handleBut;
  143.  
  144. PROCEDURE handleMsg (buf: MessageBuffer): BOOLEAN;
  145.   BEGIN
  146.     handleBreak;
  147.     RETURN TRUE
  148.   END handleMsg;
  149.  
  150. (*
  151.  * Ende der Watchdog-Prozeduren
  152.  *)
  153.  
  154. VAR kbdStack: ARRAY [1..400] OF WORD;  (* 800 Byte für Interrupt-Stack *)
  155.     Carrier: XBRA.Carrier;
  156.     kbdV: ADDRESS;
  157.     wd1carrier, wd2carrier, wd3carrier, wd4carrier: WatchDogCarrier;
  158.  
  159. PROCEDURE EnableBreak (): BOOLEAN;
  160.   VAR wdproc: EventProc; at: ADDRESS; kbdentry: ADDRESS;
  161.   BEGIN
  162.     IF ~enabled THEN
  163.       terminating:= FALSE;
  164.       Break:= FALSE;
  165.       enabled:= TRUE;
  166.       (* Watchdogs installieren *)
  167.       WITH wdproc DO
  168.         event:= timer;
  169.         timeHdler:= handleTimer;
  170.         InstallWatchDog (wd1carrier, wdproc);
  171.         event:= keyboard;
  172.         keyHdler:= handleKey;
  173.         InstallWatchDog (wd2carrier, wdproc);
  174.         event:= mouseButton;
  175.         butHdler:= handleBut;
  176.         InstallWatchDog (wd3carrier, wdproc);
  177.         event:= message;
  178.         msgType:= unspecMessage;
  179.         msgHdler:= handleMsg;
  180.         InstallWatchDog (wd4carrier, wdproc)
  181.       END;
  182.       (* Keyboard-Interrupt-Routine installieren *)
  183.       kbdV:= ADDRESS (KeyboardVectors ()) + $20L;
  184.       NewCaller (hdlKbd, FALSE, MEM (kbdStack), kbdentry);
  185.       IF NOT XBRA.Installed (Kennung, kbdV, at) THEN
  186.         XBRA.Create (Carrier, Kennung, kbdentry, entry);
  187.         XBRA.Install (entry, at);
  188.       END;
  189.     END;
  190.     RETURN TRUE
  191.   END EnableBreak;
  192.  
  193. PROCEDURE DisableBreak;
  194.   VAR at: ADDRESS;
  195.   BEGIN
  196.     IF enabled THEN
  197.       enabled:= FALSE;
  198.       IF XBRA.Installed (Kennung, kbdV, at) THEN
  199.         XBRA.Remove (at);
  200.       END;
  201.       DeInstallWatchDog (wd4carrier);
  202.       DeInstallWatchDog (wd3carrier);
  203.       DeInstallWatchDog (wd2carrier);
  204.       DeInstallWatchDog (wd1carrier);
  205.     END
  206.   END DisableBreak;
  207.  
  208.  
  209. VAR wsp: MemArea;
  210.     tcarrier: TermCarrier;
  211.  
  212. BEGIN
  213.   enabled:= FALSE;
  214.   wsp.bottom:= NIL;
  215.   CatchProcessTerm (tcarrier, DisableBreak, wsp);
  216. END UserBreak.
  217.